Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/rdblib/test.frm

Visual Basic Form | 1995-05-08 | 19.7 KB | 665 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "Royce D. Bacon (RDB) Common Library Demo"
   ClientHeight    =   5970
   ClientLeft      =   1140
   ClientTop       =   1080
   ClientWidth     =   7740
   Height          =   6660
   Icon            =   TEST.FRX:0000
   Left            =   1080
   LinkTopic       =   "Form1"
   ScaleHeight     =   5970
   ScaleWidth      =   7740
   Top             =   450
   Width           =   7860
   Begin PictureBox cMsg
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   1
      Top             =   0
      Width           =   1000
   End
   Begin PictureBox PnlHelp
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   4
      Top             =   0
      Width           =   1000
   End
   Begin PictureBox CMDialog1
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   5
      Top             =   0
      Width           =   1000
   End
   Begin PictureBox BtnEject
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   9
      Top             =   0
      Width           =   1000
   End
   Begin TextBox TxtDate
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   4020
      TabIndex        =   14
      Tag             =   "Enter the date to be validated"
      Text            =   "01/01/94"
      Top             =   4620
      Width           =   1095
   End
   Begin TextBox Txtprintwidth
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   6660
      TabIndex        =   11
      Tag             =   "Enter the line width to use"
      Text            =   "65"
      Top             =   3060
      Width           =   555
   End
   Begin TextBox Txtfmtline
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   3960
      TabIndex        =   10
      Tag             =   "Enter the beginning line for the text to print on"
      Text            =   "10"
      Top             =   3060
      Width           =   555
   End
   Begin PictureBox BtnFormat
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   13
      Top             =   0
      Width           =   1000
   End
   Begin TextBox Txtformatstring
      BackColor       =   &H00C0C0C0&
      Height          =   795
      Left            =   3960
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   12
      Tag             =   "Enter the string to be formatted"
      Text            =   "This String Will Be Formatted Into individual lines for printing.  This text should be long enough to create multiple lines on the printed output."
      Top             =   3480
      Width           =   3675
   End
   Begin TextBox Txtrjcol
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   7140
      TabIndex        =   8
      Tag             =   "Enter the rightmost column to align on"
      Text            =   "40"
      Top             =   2340
      Width           =   435
   End
   Begin TextBox Txtrjformat
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   4320
      TabIndex        =   7
      Tag             =   "Enter the format string to use for formatting the number"
      Text            =   "###,##0.00"
      Top             =   2340
      Width           =   1455
   End
   Begin PictureBox Btnrightjustify
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   15
      Top             =   0
      Width           =   1000
   End
   Begin TextBox Txtrjnum
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   4320
      TabIndex        =   6
      Tag             =   "Enter the number to be formatted"
      Text            =   "200"
      Top             =   1920
      Width           =   1455
   End
   Begin PictureBox ChkNewLine
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   16
      Top             =   0
      Width           =   1000
   End
   Begin TextBox Txtctrline
      BackColor       =   &H00C0C0C0&
      Height          =   315
      Left            =   2760
      TabIndex        =   3
      Tag             =   "Enter the line number for the string to print on"
      Text            =   "10"
      Top             =   1320
      Width           =   555
   End
   Begin PictureBox BtnCenter
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   32
      Top             =   0
      Width           =   1000
   End
   Begin TextBox Txtctrstring
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   3900
      TabIndex        =   2
      Tag             =   "Enter the string to be centered"
      Text            =   "This String Will Be Centered"
      Top             =   960
      Width           =   3675
   End
   Begin TextBox TxtErrorNum
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   4500
      TabIndex        =   0
      Tag             =   "Enter the error number to be generated"
      Text            =   "10"
      Top             =   240
      Width           =   555
   End
   Begin PictureBox Command3D2
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   33
      Top             =   0
      Width           =   1000
   End
   Begin PictureBox BtnGenError
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   34
      Top             =   0
      Width           =   1000
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackColor       =   &H00FF0000&
      Caption         =   "RB_Validate_Date"
      Height          =   255
      Index           =   4
      Left            =   0
      TabIndex        =   29
      Top             =   4320
      Width           =   7755
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackColor       =   &H00FF0000&
      Caption         =   "RB_Text_Format"
      Height          =   255
      Index           =   3
      Left            =   0
      TabIndex        =   31
      Top             =   2760
      Width           =   7755
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackColor       =   &H00FF0000&
      Caption         =   "RB_Rjustify"
      Height          =   255
      Index           =   2
      Left            =   0
      TabIndex        =   30
      Top             =   1620
      Width           =   7755
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackColor       =   &H00FF0000&
      Caption         =   "RB_ErrorHandler"
      Height          =   195
      Index           =   1
      Left            =   0
      TabIndex        =   28
      Top             =   0
      Width           =   7755
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackColor       =   &H00FF0000&
      Caption         =   "RB_Center"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   27
      Top             =   660
      Width           =   7755
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Date To Be Validated"
      Height          =   255
      Index           =   9
      Left            =   1860
      TabIndex        =   26
      Top             =   4680
      Width           =   2055
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Print Line Width"
      Height          =   255
      Index           =   8
      Left            =   4620
      TabIndex        =   25
      Top             =   3120
      Width           =   1935
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Print Starting On Line"
      Height          =   255
      Index           =   7
      Left            =   1920
      TabIndex        =   24
      Top             =   3120
      Width           =   1935
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "String To Be Formatted"
      Height          =   255
      Index           =   6
      Left            =   1860
      TabIndex        =   23
      Top             =   3480
      Width           =   1995
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "At Column"
      Height          =   255
      Index           =   5
      Left            =   5880
      TabIndex        =   22
      Top             =   2400
      Width           =   1155
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Format To Use"
      Height          =   255
      Index           =   4
      Left            =   1920
      TabIndex        =   21
      Top             =   2400
      Width           =   2295
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Number To Be Formatted"
      Height          =   255
      Index           =   3
      Left            =   1920
      TabIndex        =   20
      Top             =   1980
      Width           =   2295
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "On Line"
      Height          =   255
      Index           =   2
      Left            =   1860
      TabIndex        =   19
      Top             =   1380
      Width           =   795
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "String To Be Centered"
      Height          =   255
      Index           =   1
      Left            =   1860
      TabIndex        =   18
      Top             =   1020
      Width           =   1995
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Error Number To Generate"
      Height          =   255
      Index           =   0
      Left            =   1860
      TabIndex        =   17
      Top             =   300
      Width           =   2535
   End
   Begin Menu MnuFunc
      Caption         =   "&Functions"
      Begin Menu MnuCenter
         Caption         =   "&Center String"
      End
      Begin Menu MnuGenErr
         Caption         =   "Generate  &Error"
      End
      Begin Menu MnuFormat
         Caption         =   "&Format String"
      End
      Begin Menu MnuRightJustify
         Caption         =   "&Right Justify Number"
      End
      Begin Menu Mnudash1
         Caption         =   "-"
      End
      Begin Menu MnuPrint
         Caption         =   "&Print Page"
      End
   End
   Begin Menu MnuHelp
      Caption         =   "&Help"
      Begin Menu MnuErrHelp
         Caption         =   "&Help On Errors"
      End
      Begin Menu MnuAbout
         Caption         =   "&About"
      End
   End
Sub BtnCenter_click ()
    Dim newline As Integer
    Dim cstring As String
    ShowHelp BtnCenter, 0, 0
    cstring = TxtCtrString.Text
    nline = Val(TxtCtrLine.Text)
    newline = ChkNewLine.Value
    RB_Center cstring, nline, newline
End Sub
Sub BtnCenter_GotFocus ()
    cmsg.Caption = BtnCenter.Tag
End Sub
Sub BtnCenter_LostFocus ()
    cmsg.Caption = ""
End Sub
Sub BtnCenter_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelp BtnCenter, X, Y
End Sub
Sub BtnEject_Click ()
    ShowHelp Btneject, 0, 0
    printer.NewPage
    printer.EndDoc
End Sub
Sub BtnEject_GotFocus ()
    cmsg.Caption = Btneject.Tag
End Sub
Sub BtnEject_LostFocus ()
    cmsg.Caption = ""
End Sub
Sub BtnEject_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelp Btneject, X, Y
End Sub
Sub BtnFormat_Click ()
    Dim fstring As String
    ShowHelp BtnFormat, 0, 0
    fstring = TxtFormatString.Text
    stringtoprint = RB_Text_Format(fstring, Val(TxtPrintWidth.Text))
    printer.CurrentY = Val(TxtFmtLine.Text)
    printer.CurrentX = 0
    printer.Print stringtoprint
End Sub
Sub BtnFormat_GotFocus ()
    cmsg.Caption = BtnFormat.Tag
End Sub
Sub BtnFormat_LostFocus ()
    cmsg.Caption = ""
End Sub
Sub BtnFormat_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelp BtnFormat, X, Y
End Sub
Sub BtnGenError_Click ()
    On Error GoTo commanderror
    ShowHelp BtnGenError, 0, 0
10    Error TxtErrorNum.Text
    MsgBox "Error ignored", MB_ICONINFORMATION, "RB_ErrorHandler Test"
    Exit Sub
commanderror:
    ' Example of call to RB_ErrorHandler routine
    erraction = RB_ErrorHandler("ErrTest", "commanderror")
    Select Case erraction
    Case 1
        Resume 0
    Case 2
        Resume Next
    End Select
    Stop
End Sub
Sub BtnGenError_GotFocus ()
    cmsg.Caption = BtnGenError.Tag
End Sub
Sub BtnGenError_LostFocus ()
    cmsg.Caption = ""
End Sub
Sub BtnGenError_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelp BtnGenError, X, Y
End Sub
Sub BtnRightJustify_Click ()
    Dim rjformat As String
    Dim rjnum As Double
    ShowHelp Btnrightjustify, 0, 0
    rjformat = TxtRJFormat.Text
    rjnum = Val(TxtRJCol)
    printer.Print
    pcol = RB_Rjustify(Val(TxtRJNum.Text), rjformat, rjnum)
    printer.Print
End Sub
Sub Btnrightjustify_GotFocus ()
    cmsg.Caption = Btnrightjustify.Tag
End Sub
Sub Btnrightjustify_LostFocus ()
    cmsg.Caption = ""
End Sub
Sub Btnrightjustify_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelp Btnrightjustify, X, Y
End Sub
Sub ChkNewLine_GotFocus ()
    cmsg.Caption = ChkNewLine.Tag
End Sub
Sub ChkNewLine_LostFocus ()
    cmsg.Caption = ""
End Sub
Sub Command3D2_Click ()
    Unload form1
End Sub
Sub Command3D2_GotFocus ()
    cmsg.Caption = Command3d2.Tag
End Sub
Sub Command3D2_LostFocus ()
    cmsg.Caption = ""
End Sub
Sub Command3D2_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelp Command3d2, X, Y
End Sub
Sub FldGotFocus (PControl As Control)
    PControl.BackColor = BLUE
    PControl.ForeColor = WHITE
    PControl.SelStart = 0
    PControl.SelLength = 1000
    cmsg.Caption = PControl.Tag
End Sub
Sub FldLostFocus (PControl As Control)
    PControl.BackColor = RB_GRAY
    PControl.ForeColor = BLACK
    cmsg.Caption = ""
End Sub
Sub Form_Load ()
    rb_systemname = "RDBLIB Demo"
    rb_version = "1.2"
    printer.ScaleMode = 4
    printer.ScaleLeft = -10
End Sub
Sub MnuAbout_Click ()
    LogoForm.Show MODAL
End Sub
Sub MnuCenter_Click ()
    BtnCenter_click
End Sub
Sub MnuErrHelp_Click ()
    CMDialog1.HelpCommand = HELP_INDEX
    CMDialog1.Action = 6
End Sub
Sub MnuFormat_Click ()
    BtnFormat_Click
End Sub
Sub MnuGenErr_Click ()
    BtnGenError_Click
End Sub
Sub MnuPrint_Click ()
    BtnEject_Click
End Sub
Sub MnuRightJustify_Click ()
    BtnRightJustify_Click
End Sub
Sub ShowHelp (PBtn As Control, px As Single, py As Single)
' Subroutine to show popup help for a control
' To use:
'    add a panel control called PnlHelp to the form
'    Set control's tag property to help message desired
'    Copy this subroutine to the form code and uncomment code below
'    In mousemove event of control add
'       ShowHelp control-name, x, y
'    In click event or other events of control that cause action add
'       ShowHelp control-name, 0, 0     ' Hides help
    Dim maxx As Single, maxy As Single
    Dim nPnlTop As Single, nPnlLeft As Single
    ' Determine max x & y coordinates with 80 twip border
    ' boundry of 80 twips allowed to be able to catch cursor as exiting control
    maxx = PBtn.Width - 80
    maxy = PBtn.Height - 80
    ' if exiting control area turn off help panel
    If px < 80 Or py < 80 Or px > maxx Or py > maxy Then
        PnlHelp.Visible = False
        PnlHelp.Caption = ""
        Exit Sub
    End If
    ' Determine location for help panel
    ' Assume below and to right
    nPnlTop = PBtn.Top + PBtn.Height + 40
    nPnlLeft = PBtn.Left + 100
    ' Put panel above control if not enough room below
    If nPnlTop + PnlHelp.Height > Height - 1024 Then
        nPnlTop = PBtn.Top - PnlHelp.Height - 40
    End If
    ' Put panel to left if not enough room to right
    If nPnlLeft + PnlHelp.Width > Width - 500 Then
        nPnlLeft = PBtn.Left + PBtn.Width - 40
    End If
    ' if same settings exit to prevent flickering effect
    If PnlHelp.Caption = PBtn.Tag And PnlHelp.Top = nPnlTop And PnlHelp.Left = nPnlLeft Then
        Exit Sub
    End If
    ' get help msg from control's tag and position help panel
    PnlHelp.Caption = PBtn.Tag
    PnlHelp.Top = nPnlTop
    PnlHelp.Left = nPnlLeft
    PnlHelp.Visible = True
End Sub
Sub Txtctrline_GotFocus ()
    FldGotFocus TxtCtrLine
End Sub
Sub Txtctrline_LostFocus ()
    FldLostFocus TxtCtrLine
End Sub
Sub Txtctrstring_GotFocus ()
    FldGotFocus TxtCtrString
End Sub
Sub Txtctrstring_LostFocus ()
    FldLostFocus TxtCtrString
End Sub
Sub TxtDate_GotFocus ()
    FldGotFocus TxtDate
End Sub
Sub TxtDate_LostFocus ()
    If Not RB_Validate_Date(TxtDate) Then
        TxtDate.SetFocus
        Exit Sub
    End If
    FldLostFocus TxtDate
End Sub
Sub TxtErrorNum_GotFocus ()
    FldGotFocus TxtErrorNum
End Sub
Sub TxtErrorNum_LostFocus ()
    FldLostFocus TxtErrorNum
End Sub
Sub Txtfmtline_GotFocus ()
    FldGotFocus TxtFmtLine
End Sub
Sub Txtfmtline_LostFocus ()
    FldLostFocus TxtFmtLine
End Sub
Sub Txtformatstring_GotFocus ()
    FldGotFocus TxtFormatString
End Sub
Sub Txtformatstring_LostFocus ()
    FldLostFocus TxtFormatString
End Sub
Sub Txtprintwidth_GotFocus ()
    FldGotFocus TxtPrintWidth
End Sub
Sub Txtprintwidth_LostFocus ()
    FldLostFocus TxtPrintWidth
End Sub
Sub Txtrjcol_GotFocus ()
    FldGotFocus TxtRJCol
End Sub
Sub Txtrjcol_LostFocus ()
    FldLostFocus TxtRJCol
End Sub
Sub Txtrjformat_GotFocus ()
    FldGotFocus TxtRJFormat
End Sub
Sub Txtrjformat_LostFocus ()
    FldLostFocus TxtRJFormat
End Sub
Sub Txtrjnum_GotFocus ()
    FldGotFocus TxtRJNum
End Sub
Sub Txtrjnum_LostFocus ()
    FldLostFocus TxtRJNum
End Sub